perm filename PICY.F4[RST,LCS] blob
sn#085798 filedate 1974-02-01 generic text, type T, neo UTF8
00100 SUBROUTINE PLTMAN
00200 COMMON/PLT/JX,JY,JPL,PLT,REV,RINV,ROT,RLR,RUD,CONST,E
00300 1 ,JREV,JINV,KA,KB,KC,KD,RTO,JA,JB,JAR,JBR,A,IA,IB,IC,ID
00400 C KA-D IS FOR INVIS. INNER AREA. IA-D IS FOR INVIS. OUTER AREA.
00500
00600 COMMON JXX(4000),JCNT
00650 DATA JJX/1/,IDX/0/,JDP/50/
00660 COMMON/CLR/KP,KQ,KR,KS,P
00700
00710
00725 IXYZ=0
00750 ZLR=RLR/JPL
00775 ZUD=RUD/JPL
00875 DO 1 K=1,JCNT
01500 CALL UNPACK(K,JA,JB,N)
01510 CC IF(N.EQ.0)GO TO 2
01600 JA=ZLR*JA
01700 JB=ZUD*JB
01710
01720 IF(P)GO TO 421
01746 IF(JA.GE.KP.AND.JA.LE.KQ.AND.JB.GE.KR.AND.JB.
01772 1 LE.KS)N=3
01800 421 IF(A)GO TO 221
01900 IF(JA.GE.KA.AND.JA.LE.KB.AND.JB.GE.KC.AND.JB.
02000 1 LE.KD)N=3
02100 221 IF(E)GO TO 2222
02200 IF(JA.LE.IA.OR.JA.GE.IB.OR.JB.LE.IC.OR.JB.GE.ID)N=3
02300 C LEAVES CLEAR AREA
02700 CC IF(PLT)GO TO 210
02750 2222 IF(N.EQ.3)IXYZ=0
02800 IF(IXYZ)GO TO 211
02900 210 CALL LINES(N)
02905 NDP=NDP+1
02910 IF(NDP.LT.JDP)GO TO 211
02955 CALL DPYOUT(1)
02977 NDP=0
03000 211 IXYZ=IXYZ-1
03010 IF(IXYZ.GT.IDX)GO TO 1
03100 3 IXYZ=0
03160 C DISPLAYS EVERY JDPth TIME
03200 C DPY EVERY IDXTH TIME.
03300 CC GO TO 1
03350 CC2 CALL DPYOUT(1)
03400 CC TYPE 301
03500 CC ACCEPT 1001,WHICH
03600 CC IF(WHICH.EQ.'E'.OR.WHICH.EQ.'X')GO TO 500
03700 CC IF(WHICH.EQ.'R')GO TO 500
03800 C R=GO BACK FOR CHANGE BEFORE FINAL END.
03900 CC301 FORMAT(' CHANGE THE PEN OR R(ETURN)',$)
04000 CC IF(PLT.EQ.0)GO TO 1
04100 CC JX=JX+JJX
04200 CC JY=JY+JJX
04300 C MOVES PEN JJX NOTCHES EACH TIME AROUND.
04400 1 CONTINUE
04500 CC500 IF(PLT)CALL PLOT(0,0,3)
04700 CC1001 FORMAT(A1)
04750 CALL DPYOUT(1)
04800 END
04900
05000 SUBROUTINE UNPACK(K,JA,JB,N)
05100 COMMON JXX(4000),JCNT
05200 M=JXX(K)
05300 N=2
05400 IF(M.GE.0)GO TO 1
05500 IF(M.EQ.-1)GO TO 2
05600 M=-M
05700 N=3
05750 1 JA=M/100000
05800 JB=M-JA*100000-120
05900 JA=JA-36
06000 RETURN
06100 2 N=0
06200 END
06300 C N=0 MEANS TIME TO CHANGE PLOTTER PEN.